home *** CD-ROM | disk | FTP | other *** search
/ isnet Internet / Isnet Internet CD.iso / prog / hiz / 09 / 09.exe / adynware.exe / perl / lib / bigrat.pl < prev    next >
Encoding:
Perl Script  |  1999-12-28  |  2.6 KB  |  107 lines
  1. package bigrat;
  2. require "bigint.pl";
  3.  
  4.  
  5. sub main'rnorm { #(string) return rat_num
  6.     local($_) = @_;
  7.     s/\s+//g;
  8.     if (m#^([+-]?\d+)(/(\d*[1-9]0*))?$#) {
  9.     &norm($1, $3 ? $3 : '+1');
  10.     } else {
  11.     'NaN';
  12.     }
  13. }
  14.  
  15. sub norm { #(bint, bint) return rat_num
  16.     local($num,$dom) = @_;
  17.     if ($num eq 'NaN') {
  18.     'NaN';
  19.     } elsif ($dom eq 'NaN') {
  20.     'NaN';
  21.     } elsif ($dom =~ /^[+-]?0+$/) {
  22.     'NaN';
  23.     } else {
  24.     local($gcd) = &'bgcd($num,$dom);
  25.     $gcd =~ s/^-/+/;
  26.     if ($gcd ne '+1') { 
  27.         $num = &'bdiv($num,$gcd);
  28.         $dom = &'bdiv($dom,$gcd);
  29.     } else {
  30.         $num = &'bnorm($num);
  31.         $dom = &'bnorm($dom);
  32.     }
  33.     substr($dom,$[,1) = '';
  34.     "$num/$dom";
  35.     }
  36. }
  37.  
  38. sub main'rneg { #(rat_num) return rat_num
  39.     local($_) = &'rnorm(@_);
  40.     tr/-+/+-/ if ($_ ne '+0/1');
  41.     $_;
  42. }
  43.  
  44. sub main'rabs { #(rat_num) return $rat_num
  45.     local($_) = &'rnorm(@_);
  46.     substr($_,$[,1) = '+' unless $_ eq 'NaN';
  47.     $_;
  48. }
  49.  
  50. sub main'rmul { #(rat_num, rat_num) return rat_num
  51.     local($xn,$xd) = split('/',&'rnorm($_[$[]));
  52.     local($yn,$yd) = split('/',&'rnorm($_[$[+1]));
  53.     &norm(&'bmul($xn,$yn),&'bmul($xd,$yd));
  54. }
  55.  
  56. sub main'rdiv { #(rat_num, rat_num) return rat_num
  57.     local($xn,$xd) = split('/',&'rnorm($_[$[]));
  58.     local($yn,$yd) = split('/',&'rnorm($_[$[+1]));
  59.     &norm(&'bmul($xn,$yd),&'bmul($xd,$yn));
  60. }
  61.  
  62. sub main'radd { #(rat_num, rat_num) return rat_num
  63.     local($xn,$xd) = split('/',&'rnorm($_[$[]));
  64.     local($yn,$yd) = split('/',&'rnorm($_[$[+1]));
  65.     &norm(&'badd(&'bmul($xn,$yd),&'bmul($yn,$xd)),&'bmul($xd,$yd));
  66. }
  67.  
  68. sub main'rsub { #(rat_num, rat_num) return rat_num
  69.     local($xn,$xd) = split('/',&'rnorm($_[$[]));
  70.     local($yn,$yd) = split('/',&'rnorm($_[$[+1]));
  71.     &norm(&'bsub(&'bmul($xn,$yd),&'bmul($yn,$xd)),&'bmul($xd,$yd));
  72. }
  73.  
  74. sub main'rcmp { #(rat_num, rat_num) return cond_code
  75.     local($xn,$xd) = split('/',&'rnorm($_[$[]));
  76.     local($yn,$yd) = split('/',&'rnorm($_[$[+1]));
  77.     &bigint'cmp(&'bmul($xn,$yd),&'bmul($yn,$xd));
  78. }
  79.  
  80. sub main'rmod { #(rat_num) return (rat_num,rat_num)
  81.     local($xn,$xd) = split('/',&'rnorm(@_));
  82.     local($i,$f) = &'bdiv($xn,$xd);
  83.     if (wantarray) {
  84.     ("$i/1", "$f/$xd");
  85.     } else {
  86.     "$i/1";
  87.     }   
  88. }
  89.  
  90. sub main'rsqrt { #(fnum_str[, cycles]) return fnum_str
  91.     local($x, $scale) = (&'rnorm($_[$[]), $_[$[+1]);
  92.     if ($x eq 'NaN') {
  93.     'NaN';
  94.     } elsif ($x =~ /^-/) {
  95.     'NaN';
  96.     } else {
  97.     local($gscale, $guess) = (0, '+1/1');
  98.     $scale = 5 if (!$scale);
  99.     while ($gscale++ < $scale) {
  100.         $guess = &'rmul(&'radd($guess,&'rdiv($x,$guess)),"+1/2");
  101.     }
  102.     "$guess";          # quotes necessary due to perl bug
  103.     }
  104. }
  105.  
  106. 1;
  107.